Amiga Plus 2000 #1/Amiga Plus CD - 2000 - No. 1.iso/Tools/Grafik/Paint/Perfectpaint/rexx/general/LoadGifAnim.Ifx

Text File | 1999-12-03 | 16.9 KB | 772 lines

/*
** LoadGifAnim.Ifx
** $ver:   1.0, 17 Feb 1999
** by Bryan K. Williams, [e-mail]
** © CrystalWorks
** http://www.evilgeniuses.org/
**
** Send bug reports to [e-mail]
** Find the latest version at <http://www.evilgenius.org/crystalworks/Amiga/>
**
** Don't laugh too hard at my overuse of DO/END pairs :-)
**
** History
** 1.0, 17 Feb 1999:  Fixed stupid error on anims that had a Local Color Map
**    and transparency.  This was the only anim situation I was unable to test
**    because I couldn't find a gif that did this.  The result was corrupt gifs
**    that would cause IFX to guru.
** 0.99, 15 Feb 1999: Added support for anims that do not supply a complete
**    background in the first frame. I think I've covered most, if not all,
**    gif anim possibilities.  I know someone will prove me wrong on this :-)
** 0.15, 14 Feb 1999: Noticed bug in handling of local color tables and
**    transparency.  Should work now, but I'm unable to find a gif to test it.
**    Added some user friendliness :^)
** 0.12, 10 Feb 1999: A partial rewrite in order implement Anim Busting.  Also
**    to better handle some gifs.
** 0.10, 05 Feb 1999: Now properly handles gifs with a Disposal method of 2 (Restore
**    to background color).  Not done in the best way, but it works
** 0.9, 01 Feb 1999: Properly handles gifs with a transparent color that's duplicated
**    within the normal palette (i.e. has a black color, but also uses a second, equal
**    black for the transparent color)
** 0.8, 31 Jan 1999: Added ability to work with some (most?) delta frame gif anims.
**    Still needs to check the GCL's Disposal Method for frames to decide what to do
**    with them.
** 0.7, 26 Jan 1999: Working with full frame images
*/
/*
** Add rexxsupport.library if it isn't already open.
*/
if ~show('L',"rexxsupport.library") then
   if ~addlib('rexxsupport.library',0,-30,0) then exit 10

options results

Temp = Pragma('i')
TempDir = "T:"

Image. = ""
debug=1

loadpath=""
SavePath=""
'getprefs' 'loadpath'
if rc=0 then
do
   Loadpath = result
end

'Getprefs' 'Savepath'
if rc=0 then
do
   Savepath = result
end

/*
** Previous load info
**
** PreviousName and PreviousFrame are to clips set
** after a gif frame has been loaded.  If the same image
** is used, the script will advance to the next frame as
** the default
**
** If the same gif has been selected, PreviousSplitInfo will have various
** info about the anim, rather than parse through it again.
*/

PreviousName=GetClip('GIFLoaderPrevName')
if PreviousName~="" then
do
   LoadPath = GetPath(previousName)
end
PreviousFrame=GetClip('GIFLoaderPrevFrame')
result = GetClip('GIFSaveDir')
if result~="" then
do
   SavePath = result
end

if PreviousFrame="" | ~datatype(PreviousFrame,'W') then
do
   PreviousFrame=1
end

FullFrameFlag = 1
TranspFlag = 0

'Getmain'
if rc=0 then
do
   'requestresponse' '"Do you wish to overwrite the current buffer?"'
   if rc~=0 then exit
end

'RequestFile' '"Load Gif Anim"' 'Path' LoadPath 'Pattern *.gif'
if rc~=0 then exit
filename = result

if upper(right(filename,4))=".GIF" then
do
   savefile = getfile(filename)
   savefile = left(savefile,length(savefile)-4)
end
else
do
   savefile=getfile(filename)
end

if filename=PreviousName then
do
   PreviousFrame=PreviousFrame+1
end
else
do
   PreviousFrame=1
end

if ~open('in',filename,'r') then
do
   'RequestNotify' 'Unable to open file' Filename
   exit
end

header=""

Call CheckId()
Call GetLSD()

/*
** read global color table (maybe)
** 3 bytes * 2^bitplates
*/

gct=""
if Globalcolor=1 then
do
   GCT = GetCT(sizeotable)
end

Call CountFrames()

BackgroundFlag = CheckBackground()
if BackgroundFlag=1 then FullFrameFlag=0

if framecount<=0 then
do
   'Requestnotify' '"Gif has no images! (How Odd)"'
   call quit()
end

/* if framecount = 1 then just load the damn thing! */
if framecount=1 then
do
   'LoadBuffer' '"'filename'"'
   call quit()
end

/*
**    BustAnim : This variable decides if we're going to
** just break up the entire Anim (1) or load just one
** frame (0)
**
**    Accuracy : This variable decides the method of loading
** the gif.  Some gifs are anims in which each frame is the
** entire frame.  For these, you want to do a quick load.
** Others are delta frames, they only have what's different
** between each frame of animation.  These are more complex
** and require some processing.
**
**    This section tries to figure out what kind of anim the
** gif is.  If it can't figure it out, it asks you if you want
** to try a QUICK load.  Try it and see.  If it doesn't work,
** go back and do an accurate load.
*/

BustAnim=0  /* Don't Bust Anim */
Accuracy=0  /* Quick load */
'requestresponse' '"Do you wish to bust this anim?"'
if rc=0 then
do
   BustAnim=1
   Accuracy=1
   'requestfile' 'DIRONLY' 'Path' Savepath 'Title "Save file directory"'
   if rc~=0 then
   do
      call quit()
   end
   Savepath = result
   if right(savepath,1)~='/' & right(savepath,1)~=':' then
   do
      savepath = savepath||'/'
   end
end

'lockgui'
'lockinput'

if BustAnim=0 then
do
   reqFrame = REquestFrame()

/* make sure a frame was selected */
   if ~datatype(ReqFrame,'W') then
   do
      call quit()
   end
end
else
do
   ReqFrame = FrameCount
end

if FullFrameFlag=1 then
do
   if TranspFlag=0 then
   do
      Accuracy=0
   end
   else
   do
      'requestresponse' '"Do you wish to try to load QUICK?"'
      if rc=0 then
      do
         Accuracy=0
      end
      else
      do
         Accuracy=1
      end
   end
end
else
do
   Accuracy=1
end


if Accuracy=0 & BustAnim=0 then
do
   call SaveFrame(ReqFrame)
   'LoadBuffer' '"'TempDir||Temp'.gif"'
   call delete(Tempdir||Temp'.gif')
end
else
/* We're doing a Accurate load, and may be busting an anim */
Do count = 1 to ReqFrame
   Call CreateImage(count)
end

call quit()
exit

**************************
CheckId:

/*
** read identifier
** 6 bytes
*/

line = readch('in',6)
if line ~="GIF89a"  & line ~="GIF87a" then
do
   RequestNotify '"'filename' is not an gif."'
   call quit()
end
header=header||line
return

**************************
GetLSD:

/*
** LSD - Logical Screen Descriptor (no, not a drug)
** reads the logical screen descriptor, 7 bytes
**
** Ok, a lot of this stuff can probably be taken out, but
** it helped in making the dang thing :-)
*/

LSD=readch('in',7)
/* Screen width/height, which may or may not be image width/height */
width = c2d(reverse(substr(lsd,1,2)))
height = c2d(reverse(substr(lsd,3,2)))

stuff = c2b(substr(lsd,5,1))
GlobalColor = c2d(b2c(substr(stuff,1,1)))
colorRes = c2d(b2c(substr(stuff,2,3))) +1
TotalPalette = (2**colorres)**3
sortflag = c2d(b2c(substr(stuff,5,1)))
sizeotable = c2d(b2c(substr(stuff,6,3)))+1
backgrd = c2d(substr(lsd,6,1))

ratio = c2d(substr(lsd,7,1))
if ratio=0 then ratio=1

header=header || lsd

Return

/***************************/

GetCT: procedure
/*
** Reads a Color Table
*/
parse arg TableSize
return(readch('in',3*(2**TableSize)))

/***************************/

CountFrames:

/*
** This subroutine will count the number of frames in the image
** and also figure out the start and end position of each frame
** for quicker loading
*/

framecount = 0
/* get current position, so we can return */

do while ~eof('in')
   nx = readch('in',1)

   framecount=framecount+1

   do while nx~="2C"x & Nx~='3B'x
      if nx = '21'x then
      do
         if skipBlocks()=0 then
         do
            framecount=framecount-1
            return
         end
      end
      else
      do
         'requestnotify' '"Somethings very wrong.  Hex character 'c2x(nx)' found.  Exiting..."'
         call quit()
      end

      nx = readch('in',1)
   end

/* found all the frames */
   if nx='3b'x then
   do
      framecount= framecount-1
      return
   end

/* Finally found an image */

   Image.framecount.start=seek('in',0)-1

   code.=""
   codecount = 0
   codehead = nx||readch('in',9)

   Image.Framecount.left   = c2d(reverse(substr(codehead,2,2)))
   Image.Framecount.top    = c2d(reverse(substr(codehead,4,2)))
   Image.Framecount.width  = c2d(reverse(substr(codehead,6,2)))
   Image.Framecount.height = c2d(reverse(substr(codehead,8,2)))

   if Image.framecount.left~=0 | Image.framecount.top~=0 | Image.framecount.width~=width | Image.framecount.height~=Height then
   do
      FullFrameFlag = 0
   end

   stuff = c2b(right(codehead,1))
   localcolor = left(stuff,1)
   interlace = substr(stuff,2,1)

   localsortflag = substr(stuff,3,1)
   localcolortable = c2d(b2c(right(stuff,3)))+1

   if localcolor=1 then
   do
      Image.FrameCount.LCT = getCT(localcolortable)
   end

   call seek('in',1)
   chsz = c2d(readch('in',1))

   do while chsz>0
      call seek('in',chsz)
      chsz = c2d(readch('in',1))
   end

   /* end of image */
   Image.framecount.end = seek('in',0)
end
'requestnotify' '"Gif is incomplete.  May be a problem with final image"'
framecount=framecount-1
return

/***************************/
SaveFrame:
/*
** read the appropriate data out of the gif and
** construct a new gif, save to T:, load new gif, and delete temp gif
*/

Parse Arg SaveFrame
call seek('in',image.SaveFrame.Start,'B')
Data = readch('in',Image.SaveFrame.end-Image.SaveFrame.Start)

tempGCT = GCT
if image.saveframe.transflag=1 & Accuracy=1 then
do
   origTrans = Pickcolor(image.saveframe.transcolor gct)
   if Image.saveframe.lct~="" then
   do
      if CheckTransparent(image.saveframe.transcolor image.saveframe.lct)>=0 then
      do
         tempLCT = replacetransparent(image.saveframe.transcolor image.saveframe.lct)
         data = overlay(templct,data,11)
      end
   end
   else
   do
      if CheckTransparent(image.saveframe.transcolor gct)>=0 then
      do
         tempgct = replacetransparent(image.saveframe.transcolor gct)
      end
   end
end

if ~open('out',TempDir||Temp'.gif','w') then
do
   'RequestNotify' 'Unable to open Temporary File, exiting...'
   call quit()
end

call writech('out',header||tempGCT||data||'3b'x)
call close('out')

return

/***************************/
SkipBlocks:
/*
** There are some gif extension codes here
** The only one we're interested in is the "Graphic Control Extension"
** because that will tell us how to work with delta frames and
** the transparent color of such frames
*/

bltype = readch('in',1)
len = c2d(readch('in',1))

select
   when bltype = 'F9'x then
   do
      extdata = readch('in',len)
      stuff = c2b(left(extdata,1))
/*
** TransFlag is either 1 for transparent color, or 0 for no transparent color
** Transcolor is # from 0-255 which is index of the transparent color
** Disposal method is the way the frame is dealt with after use
** I may not have a use for it.
*/

      Image.framecount.TransFlag  = right(stuff,1)
      if Image.Framecount.TransFlag=1 then
      do
         TranspFlag=1
      end
      Image.framecount.transcolor = c2d(right(extdata,1))
      Image.framecount.disposal   =   c2d(b2c(substr(stuff,4,3)))
   end
   when bltype = 'FF'x then
   do
      call seek('in',len) /* skipApplication Extension type */
      BlkLen = c2d(readch('in',1)) /* read length of extension type */
      call seek('in',blklen) /* skip Application Extension data */
   end
   otherwise
   do
      call seek('in',len) /* read in other extension data */
   end
end

ending = readch('in',1)
if ending~='00'x then return(0)

return(1)

/***************************/
pickcolor: Procedure

/*
** Input: Index number, color table
**    picks the index color number out of the color table
*/


parse arg index ' ' table
temp = (substr(table,(index)*3+1,3))
return(c2d(left(temp,1))' 'c2d(substr(temp,2,1))' 'c2d(right(temp,1)))

/***************************/
ReplaceTransparent: procedure

/*
** This procedure will replace a duplicated transparent color in a palette
** with a different color.  It does this by getting a completely random color
** to replace it with, since the odds of getting a random duplicate are small
** (256 out of 16 million :^)
*/
parse arg index ' ' table
call randu(time('s'))
done = '0'

do while done>=0
   rgb = d2c(random(0,255))||d2c(random(0,255))||d2c(random(0,255))
   table = overlay(rgb,table,(index)*3+1,3)
   done = checktransparent(index table)
end
return(table)

/***************************/
CheckTransparent: procedure

/*
** This procedure checks to make sure that the transparent color
** isn't repeated elsewhere within the palette.  Since Gifs are colormapped
** it's possible to have the same color transparent, and not transparent, and
** since IFX works in 24 bit, it would be unable to tell the difference between the
** two.
*/
parse arg index ' ' table

color = pickcolor(index table)

do count=0 to length(table)/3-1
   if count~=index then
   do
      temp = pickcolor(count table)
      if temp=color then return(count)
   end
end

return(-1)
/***************************/
RequestFrame:

if PreviousFrame>framecount then
do
   PreviousFrame=Framecount
end
'requestslider "Load which Frame" 1' framecount PreviousFrame
if rc>0 then
do
   call quit()
end
return(result)
/***************************/

CreateTranspBrush:

parse arg tranbrush
ColorTable=tempGCT
if Image.count.LCT~="" then
do
   ColorTable=Image.count.LCT
end
'swap'
'LoadBuffer' '"'tranbrush'"'
TranColor = PickColor(Image.Count.TransColor colortable)
/*Trancolor = c2d(left(trancolor,1))  c2d(substr(trancolor,2,1)) c2d(right(trancolor,1))*/
'activecolor'
actpal = result
'GetPalette' '-1'
oldpal = result
'setpalette' actpal tranColor
'getrange 1'
oldrang = result
'setrange 1' actpal actpal
'transparency exclude 1 closeness 1'
OldTran = result
'getmain'
parse var result '"' . '"' wid hei .
'scissors'
'box 0 0' wid hei
'setrange 1' oldrang
'setpalette' actpal oldpal
'transparency' oldtran
'swap'
return

/***************************/
DoDisposal:

/*
** Disposal methods
**    0 : No disposal specified.  The decoder is not required
** to take any action.
**    1 : Do Not dispose.  The graphic is to be left in place.
**    2 : Restore to background color.  The area used by the
** graphic must be restored to the background color.
**    3 : Restore to previous.  The decoder is required to restore
** the area overwritten by the graphic with what was there prior
** to rendering the graphic
**    4-7 : undefined (shouldn't happen?)
*/

select
   when Image.count.Disposal<2 | Image.count.Disposal>3 then
   do
      'brushhandle' 0 0
      'point' image.count.left   image.count.top
   end

   when image.count.Disposal=3 & (count=ReqFrame | Bustanim=1) then
   do
      'brushhandle' 0 0
      'point' image.count.left   image.count.top
   end

   when Image.count.Disposal=2 & (count=ReqFrame | bustanim=1) then
   do
      'brushhandle' 0 0
      'point' image.count.left   image.count.top
   end
   otherwise nop
end

return

/***************************/
UndoDisposal:

if image.count.Disposal=2 then
do
   'activecolor'
   actpal = result
   'GetPalette' '-1'
   oldpal = result
   /*bg = Pickcolor(backgrd GCT)*/

   'setpalette' actpal OrigTrans
   'filledbox' image.count.left image.count.top image.count.width image.count.height
   'setpalette' actpal oldpal
end
else if image.count.disposal=3 & BustAnim=1 then
do
   'UNDO'
end

return

/***************************/

CreateImage:
/*
** First frame, just load it
*/
if count=1 then
do
   if image.count.transflag=1 then
   do
      ColorTable=GCT
      if Image.count.LCT~="" then
      do
         ColorTable=Image.count.LCT
      end
      TranColor = PickColor(Image.Count.TransColor colortable)
      OrigTrans = TranColor
   end
   if Backgroundflag~=1 then
   do
      'LoadBuffer' '"'filename'"'
   end
   else
   do
      'CreateBuffer force' width height pickcolor(image.count.transcolor GCT)
      if Image.count.transflag=1 then
      do
         tempgct = gct
         call CreateTranspBrush(filename)
      end
      else
      do
         'LoadBrush' '"'filename'"'
      end
      Call DoDisposal()
   end
end
else
do

   call SaveFrame(Count)

/*
** Image has transparent color
*/
   if Image.count.transflag=1 & Accuracy=1 then
   do
      call CreateTranspBrush(Tempdir||Temp'.gif')
   end
   else
   do
      'LoadBrush' '"'TempDir||Temp'.gif"'
   end
   call delete(Tempdir||Temp'.gif')

   Call DoDisposal()
end

if BustAnim=1 then
do
   Call SaveImage()
end
if Accuracy=1 & count~=ReqFrame then
do
   call UndoDisposal()
end
return

/***************************/
SaveImage:

'SAVEBUFFERAS' 'ILBM' savepath || savefile || right(count,length(framecount),'0') || '.rgb'
return

/***************************/
GetPath: Procedure

parse arg path

return(left(path,max(pos(':',path),lastpos('/',path))))
/***************************/
GetFile: Procedure

parse arg path
return(delstr(path,1,max(pos(':',path),lastpos('/',path))))


/***************************/

CheckBackground:

right = image.1.left+image.1.width
bottom = image.1.top + image.1.height

do count = 2 to framecount
   if (image.count.left + image.count.width)>right | (image.count.top + image.count.height)>bottom then return(1)
end
return(0)

/***************************/
quit:

call close('in')
'unlockgui'
'unlockinput'
call setclip('GIFLoaderPrevName',filename)
call setClip('GIFLoaderPrevFrame',ReqFrame)
call setclip('GIFSaveDir',SavePath)
'killbrush'
'redraw'
exit